home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / guile-ii.src / guile-ii / guile-src / slib / fluidlet.scm < prev    next >
Encoding:
Text File  |  1994-12-07  |  1.4 KB  |  46 lines

  1. ; "fluidlet.scm", FLUID-LET for Scheme
  2. ; Copyright (c) 1992, Dorai Sitaram (dorai@cs.rice.edu)
  3. ;
  4. ;Permission to copy this software, to redistribute it, and to use it
  5. ;for any purpose is granted, subject to the following restrictions and
  6. ;understandings.
  7. ;
  8. ;1.  Any copy made of this software must include this copyright notice
  9. ;in full.
  10. ;
  11. ;2.  I have made no warrantee or representation that the operation of
  12. ;this software will be error-free, and I am under no obligation to
  13. ;provide any services, by way of maintenance, update, or otherwise.
  14. ;
  15. ;3.  In conjunction with products arising from the use of this
  16. ;material, there shall be no use of my name in any advertising,
  17. ;promotional, or sales literature without prior written consent in
  18. ;each case.
  19.  
  20. (require 'rev4-optional-procedures)
  21. (require 'common-list-functions)
  22. (require 'dynamic-wind)
  23. (require 'macro)
  24.  
  25. (define list-set! (lambda (s i v) (set-car! (list-tail s i) v)))
  26.  
  27. (define-syntax fluid-let
  28.   (syntax-rules ()
  29.     ((fluid-let ((x v) ...) . body)
  30.      (let ((%x-names (list 'x ...))
  31.        (%x-values (list x ...))
  32.        (%fluid-x-values (list v ...)))
  33.        (dynamic-wind
  34.      (lambda ()
  35.            (set! x (list-ref %fluid-x-values
  36.                (comlist:position 'x %x-names)))
  37.            ...)
  38.      (lambda () . body)
  39.      (lambda ()
  40.            (let ((%x-position (comlist:position 'x %x-names)))
  41.              (list-set! %fluid-x-values %x-position x)
  42.          (set! x (list-ref %x-values %x-position)))
  43.        ...))))))
  44.  
  45. ;--- end of file
  46.